home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / DELPHI / D_TAPI.ZIP / MONFORM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-01  |  3.8 KB  |  152 lines

  1. unit MonForm;
  2. {
  3.     *** TAPI Monitor ***
  4.     by Davide Moretti <dmoretti@iper.net>
  5.  
  6.     This is a TAPI Test
  7.     It uses TAPI interface to monitor outgoing calls
  8.     Open this program, and then make a call with
  9.     Remote Access or something that uses TAPI
  10.  
  11.     I used TAPI only to monitor calls, since I am wriing
  12.     a toll accounting program.
  13. }
  14.  
  15. interface
  16.  
  17. uses
  18.     WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Tapi,
  19.     StdCtrls;
  20.  
  21. type
  22.     TfrmTAPIMon = class(TForm)
  23.     Memo1: TMemo;
  24.         procedure FormCreate(Sender: TObject);
  25.         procedure FormDestroy(Sender: TObject);
  26.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  27.     private
  28.         { Private declarations }
  29.         lineApp: THLineApp;
  30.         line: THLine;
  31.     public
  32.         { Public declarations }
  33.     end;
  34.  
  35. var
  36.     frmTAPIMon: TfrmTAPIMon;
  37.  
  38. implementation
  39.  
  40. {$R *.DFM}
  41.  
  42. uses Main;
  43.  
  44. var
  45.     buf:array[0..1023] of char;
  46.     callinfo: TLineCallInfo absolute buf;
  47.     {
  48.         these two variables points to the same address.
  49.         since lineGetCallInfo expects a buffer with a TLineCallInfo on top.
  50.     }
  51.  
  52. {
  53.     TAPI Callback procedure: called for TAPI messages
  54.     you MUST use 'stdcall' since it is called by Windows
  55. }
  56. procedure lineCallback(hDevice, dwMsg, dwCallbackInstance,
  57.         dwParam1, dwParam2, dwParam3: LongInt);
  58. {$IFDEF WIN32}
  59.         stdcall;
  60. {$ELSE}
  61.         export;
  62. {$ENDIF}
  63.     var
  64.         s: string;
  65.         hCall: THCall;
  66.     begin
  67.     if dwMsg = LINE_CALLSTATE then    { change in line state }
  68.         begin
  69.         hCall := THCall(hDevice);
  70.         case dwParam1 of
  71.             LINECALLSTATE_IDLE:        { call terminated }
  72.                 if hcall <> 0 then
  73.                     begin
  74.                     lineDeallocateCall(hCall);    { you must deallocate the monitored call }
  75.                     frmTAPIMon.Memo1.Lines.Add( 'Idle - monitored call deallocated');
  76.                     end;
  77.             LINECALLSTATE_CONNECTED:    { Service connected }
  78.                 if hCall <> 0 then
  79.                     begin
  80.                     s := 'Connected: ';
  81.                     callinfo.dwTotalSize := 1024;
  82.                     if lineGetCallInfo(hCall, callinfo) = 0 then
  83.                         if callinfo.dwAppNameSize > 0 then
  84. {$IFDEF WIN32}
  85.                             s := s + (buf + callinfo.dwAppNameOffset); { this is more C-ish... }
  86. {$ELSE}
  87.                             s := s + StrPas((buf + callinfo.dwAppNameOffset)); { this is more C-ish... }
  88. {$ENDIF}
  89.                     frmTAPIMon.Memo1.Lines.Add( s);
  90.                     end;
  91.             LINECALLSTATE_PROCEEDING:        { call proceeding (dialing) }
  92.                 frmTAPIMon.Memo1.Lines.Add( 'Proceeding');
  93.             LINECALLSTATE_DIALING:            { call dialing }
  94.                 frmTAPIMon.Memo1.Lines.Add( 'Dialing');
  95.             LINECALLSTATE_DISCONNECTED:    { Disconnected }
  96.                 frmTAPIMon.Memo1.Lines.Add('Disconnected');
  97.             end;
  98.         end;
  99.     end;
  100.  
  101. procedure TfrmTAPIMon.FormCreate(Sender: TObject);
  102.     var
  103.         nDevs, tapiVersion: Longint;
  104.         extid: TLineExtensionID;
  105.         params: TLineCallParams;
  106.     begin
  107.     { Initialize TAPI }
  108.     if lineInitialize(lineApp, HInstance,
  109.             @lineCallback, nil, nDevs) < 0 then        { < 0 is an error }
  110.         lineApp := 0
  111.     else if nDevs = 0 then        { no TAPI devices?? }
  112.         begin
  113.         lineShutDown(lineApp);
  114.         lineApp := 0;
  115.         end
  116.     else if lineNegotiateAPIVersion(lineApp, 0, $00010000, $10000000,
  117.             tapiVersion, extid) < 0 then    { Check for version (copied from a TAPI sample) }
  118.         begin
  119.         lineShutDown(lineApp);
  120.         lineApp := 0;
  121.         end
  122.     { Open a line for monitor (here I use first device, normally the modem) }
  123.     else if lineOpen(lineApp, 0, line, tapiVersion, 0, 0,
  124.             LINECALLPRIVILEGE_MONITOR, LINEMEDIAMODE_DATAMODEM, params) < 0 then
  125.         begin
  126.         lineShutDown(lineApp);
  127.         lineApp := 0;
  128.         line := 0;
  129.         end;
  130.     if lineApp <> 0 then
  131.         Memo1.Lines.Add( 'Monitoring calls...')
  132.     else
  133.       Memo1.Lines.Add( 'Error!');
  134.     end;
  135.  
  136. procedure TfrmTAPIMon.FormDestroy(Sender: TObject);
  137.     begin
  138.     { Terminate TAPI }
  139.     if line <> 0 then
  140.         lineClose(line);
  141.     if lineApp <> 0 then
  142.         lineShutDown(lineApp);
  143.     frmMain.Monitor := False;
  144.     end;
  145.  
  146. procedure TfrmTAPIMon.FormClose(Sender: TObject; var Action: TCloseAction);
  147.     begin
  148.   Action := caFree;
  149.     end;
  150.  
  151. end.
  152.